home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b8.d64 / demo 4.2.l < prev    next >
Text File  |  2007-02-28  |  3KB  |  192 lines
  1. 0010 //  DELETE "0:HOUSE.L.1"
  2. 0020 //   M.SKELTON
  3. 0030 //  SAVE "0:HOUSE.L.3"
  4. 0040 //
  5. 0050 //  PROCEDURES
  6. 0060 //
  7. 0070 PROC INIT 
  8. 0080 SETGRAPHIC 0
  9. 0090 HIDETURTLE 
  10. 0100 BORDER 0
  11. 0110 BACKGROUND 0
  12. 0120 CLEAR 
  13. 0130 ENDPROC INIT
  14. 0140 //
  15. 0150 PROC WAIT(X) 
  16. 0160 T:=PEEK(162)+X; T1:=PEEK(162)
  17. 0170 WHILE T1<T DO
  18. 0180 T1:=T1+1
  19. 0190 ENDWHILE 
  20. 0200 ENDPROC WAIT
  21. 0210 //
  22. 0220 PROC WALK 
  23. 0230 MOVETO 155,49
  24. 0240 SETHEADING 215
  25. 0250 FORWARD 200
  26. 0260 MOVETO 165,49
  27. 0270 SETHEADING 145
  28. 0280 FORWARD 200
  29. 0290 ENDPROC WALK
  30. 0300 //
  31. 0310 PROC GROUND CLOSED
  32. 0320 PENCOLOR 5
  33. 0330 X:=130
  34. 0340 FOR I:=0 TO 48 DO
  35. 0350 MOVETO 0,I
  36. 0360 IF I MOD 2=0 THEN
  37. 0370 PENCOLOR 5
  38. 0380 ELSE 
  39. 0390 PENCOLOR 13
  40. 0400 ENDIF 
  41. 0410 DRAWTO X,I
  42. 0420 X:=X+.5
  43. 0430 ENDFOR I
  44. 0440 X:=190
  45. 0450 FOR I:=0 TO 48 DO
  46. 0460 MOVETO 319,I
  47. 0470 IF I MOD 2=0 THEN
  48. 0480 PENCOLOR 5
  49. 0490 ELSE 
  50. 0500 PENCOLOR 13
  51. 0510 ENDIF 
  52. 0520 DRAWTO X,I
  53. 0530 X:=X-.5
  54. 0540 ENDFOR I
  55. 0550 ENDPROC GROUND
  56. 0560 //
  57. 0570 PROC HOUSE 
  58. 0580 MOVETO 120,49
  59. 0590 SETHEADING 0
  60. 0600 FOR I:=1 TO 2 DO
  61. 0610 FORWARD 51
  62. 0620 RIGHT 90
  63. 0630 FORWARD 80
  64. 0640 RIGHT 90
  65. 0650 ENDFOR I
  66. 0660 ENDPROC HOUSE
  67. 0670 //
  68. 0680 PROC ROOF 
  69. 0690 HOME 
  70. 0700 MOVETO 120,100
  71. 0710 RIGHT 55
  72. 0720 BACK 5
  73. 0730 FORWARD 54
  74. 0740 RIGHT 70
  75. 0750 FORWARD 54
  76. 0760 ENDPROC ROOF
  77. 0770 //
  78. 0780 PROC DOOR 
  79. 0790 MOVETO 155,50
  80. 0800 SETHEADING 0
  81. 0810 FORWARD 20
  82. 0820 RIGHT 90
  83. 0830 FORWARD 10
  84. 0840 RIGHT 90
  85. 0850 FORWARD 20
  86. 0860 PLOT 162,60
  87. 0870 ENDPROC DOOR
  88. 0880 //
  89. 0890 PROC WINDOW(X,Y,H,W) 
  90. 0900 SETHEADING 0
  91. 0910 MOVETO X,Y
  92. 0920 FOR I:=1 TO 2 DO
  93. 0930 FORWARD H
  94. 0940 RIGHT 90
  95. 0950 FORWARD W
  96. 0960 RIGHT 90
  97. 0970 ENDFOR I
  98. 0980 SETHEADING 0
  99. 0990 MOVETO X+4,Y
  100. 1000 FORWARD H
  101. 1010 MOVETO X,Y+4
  102. 1020 RIGHT 90
  103. 1030 FORWARD W
  104. 1040 ENDPROC WINDOW
  105. 1050 //
  106. 1060 PROC TRUNK(X,Y,L) 
  107. 1070 MOVETO X,Y
  108. 1080 SETHEADING 0
  109. 1090 PENCOLOR 10
  110. 1100 FORWARD L
  111. 1110 ENDPROC TRUNK
  112. 1120 //
  113. 1130 PROC TREE(L) 
  114. 1140 PENCOLOR 5
  115. 1150 IF L>4 THEN
  116. 1160 RIGHT 45
  117. 1170 FORWARD L
  118. 1180 TREE(L*.75)
  119. 1190 IF L<5 THEN BLOSSOM
  120. 1200 BACK L
  121. 1210 LEFT 90
  122. 1220 FORWARD L
  123. 1230 TREE(L*.75)
  124. 1240 IF L<5 THEN BLOSSOM
  125. 1250 BACK L
  126. 1260 RIGHT 45
  127. 1270 ENDIF 
  128. 1280 ENDPROC TREE
  129. 1290 //
  130. 1300 PROC BLOSSOM 
  131. 1310 PENCOLOR 7
  132. 1320 X:=XCOR
  133. 1330 Y:=YCOR
  134. 1340 PLOT X,Y
  135. 1350 PLOT X,Y+1
  136. 1360 PLOT X+1,Y
  137. 1370 PLOT X+1,Y+1
  138. 1380 PENCOLOR 5
  139. 1390 ENDPROC BLOSSOM
  140. 1400 //
  141. 1410 FUNC XCOR CLOSED
  142. 1420 HIGH'BIT#:=PEEK(27255)
  143. 1430 RETURN HIGH'BIT#*256+PEEK(27256)
  144. 1440 ENDFUNC XCOR
  145. 1450 //
  146. 1460 FUNC YCOR CLOSED
  147. 1470 RETURN 199-PEEK(27260)
  148. 1480 ENDFUNC YCOR
  149. 1490 //
  150. 1500 PROC BIRD1(X,Y) 
  151. 1510 MOVETO X,Y
  152. 1520 LEFT 45
  153. 1530 FORWARD 5
  154. 1540 BACK 5
  155. 1550 RIGHT 90
  156. 1560 FORWARD 5
  157. 1570 ENDPROC BIRD1
  158. 1580 //
  159. 1590 // MAIN
  160. 1600 //
  161. 1610 INIT
  162. 1620 GROUND
  163. 1630 PENCOLOR 1
  164. 1640 HOUSE
  165. 1650 ROOF
  166. 1660 DOOR
  167. 1670 WINDOW(130,60,9,8)
  168. 1680 WINDOW(180,60,9,8)
  169. 1690 WINDOW(130,80,9,8)
  170. 1700 WINDOW(180,80,9,8)
  171. 1710 WINDOW(155,80,9,8)
  172. 1720 PENCOLOR 2
  173. 1730 FILL 125,51
  174. 1740 PENCOLOR 1
  175. 1750 FILL 125,101
  176. 1760 TRUNK(60,49,31)
  177. 1770 TREE(20)
  178. 1780 TRUNK(60,49,26)
  179. 1790 TREE(15)
  180. 1800 TRUNK(265,49,31)
  181. 1810 TREE(20)
  182. 1820 TRUNK(265,49,26)
  183. 1830 TREE(15)
  184. 1840 PENCOLOR 1
  185. 1850 BIRD1(100,180)
  186. 1860 REPEAT 
  187. 1870 NULL
  188. 1880 UNTIL KEY$<>CHR$(0)
  189. 1890 SETTEXT 
  190. 1900 PRINT "ô"
  191. 1910 END 
  192.